#!/usr/bin/perl
## install - installer for ULCC EPrints mods
## $Id: install 841 2008-09-03 15:11:00Z cziabjw $
##
## The default destination(s) to consider are read from TARGETS. If none
## found, this is a fatal error as it most likely means user has checked 
## out the wrong branch. 
##
## If the user running this script does not have write access to the target,
## attempts to sudo to the owner of the target dir (ie the eprints user). 
## Since *that* user in turn might not have access to *this* dir, a 2-step
## copy is performed.
##
## Files in ./archives/ARCHIVEID are copied to *all* subdirs of 
## $target/archives -- except the special case 'vanilla', which is
## left alone.

use strict;
use warnings;
use File::Basename;
use File::Compare;
use File::Copy;
use File::Find;
use File::Glob qw(:glob);
use File::Path;
use FileHandle;
use Getopt::Std;

$ENV{PATH} = '/bin:/usr/bin';
my $TARGET = "/www/soasfh-test/docroot/php";
my $TMPDIR = $ENV{'TMPDIR'} || '/tmp';
my $SUDO = "sudo -p 'Enter password for \%u\@\%h: '";

#### Main ################################################################

## Useful values

my $mydir = dirname($0);
my $prog = basename($0);

## Global for use by File::Find

my @files;

## Try to ensure group-writeability and world-readability

umask(002);

## Be in the source dir so that source paths are relative and can be
## simply appended to the dest path

chdir($mydir) or die "Can't chdir to $mydir!";

my %opt;
getopts('dfn', \%opt) or &usage;
$opt{'n'} = 1 if ($opt{'d'}); ## -d implies -n
my $not = $opt{'n'} ? 'NOT ' : '';


print "\nTarget:\n", $TARGET, "\n";
unless ($opt{n}) {
  print "Proceed with installation? (y/n) ";
  my $yn = <STDIN>;
  die "Aborted.\n" unless ($yn =~ /^y/i);
}

#  my %do_postinst; ## Post-install actions to schedule for this target
#  my @archiveids;  ## Archive IDs within this target
my ($tinst, $terr);
  my $tmpdir = "$TMPDIR/eprints_install.$$." . sprintf("%08x",rand(2**32));
  mkdir($tmpdir, 0775) or die "Can't create temporary directory '$tmpdir': $!";

  my @things_to_install = qw(mobile);

  my $dest = $TARGET;
  foreach my $thing (@things_to_install) {
    if (-e $thing) {
      print "Considering '$thing'...\n";
      my ($ninst, $nerr) = &install_thing($thing, $dest, $tmpdir);
      $tinst += $ninst;
      $terr  += $nerr;
      print "\n";
    }
  }


## File::Find 'wanted' function
sub find_files
{
  return if $File::Find::name =~ m(/\.svn(/|$));
  if (-f) {
    # print "find: $File::Find::name\n";
    push @files, $File::Find::name;
  }
}

sub files_to_install
{
  my ($from, $todir, $tmpdir) = @_;
  @files = ();
  if (-d $from) {
    find(\&find_files, $from);
  } else {
    @files = ($from);
  }

  # print scalar @files, " installation candidates\n";
  my $filemap = &calculate_install($todir, $tmpdir, @files);
  return $filemap;
}

## Returns the username that owns the given file or dir
sub owner
{
  my $file = shift;
  my $owner_uid = (stat($file))[4];
  my $owner_name = (getpwuid($owner_uid))[0];
  return $owner_name || $owner_uid;
}

sub install_thing
{
  my ($from, $todir, $tmpdir) = @_;
  my $owner = &owner($todir);

  my $destmap = &files_to_install($from, $todir, $tmpdir);
  return (0,0) unless keys %$destmap;

  print "Installing '$from' to '$todir'...";

  my $ninst = 0;
  my $nerr = 0;
  foreach my $src (keys %$destmap) {
    my $destmode = -x $src ? 0775 : 0664;
    my $dirmode = 0775;
    my $destmode_str = sprintf("%o", $destmode);
    my $dirmode_str = sprintf("%o", $dirmode);
    ## Get mtime from source file to apply to dest
    my $mtime = (stat($src))[9];
    if (! -w $todir) {
      ## First copy to an intermediate location
      my $intermediate = "$tmpdir/$src";
      unless ($opt{'n'}) {
        eval {
          if (! -d dirname($intermediate)) {
            mkpath(dirname($intermediate)) or die "Failed to create destination directory.\n";
          }
          copy($src, $intermediate) or die "Failed to copy: $!\n";
          chmod($destmode, $intermediate) or die "Failed to chmod.\n";
        };
        if ($@) {
          warn "1st stage copy failed: $@\n";
          $nerr++;
          next;
        }
        ## Set mtime on intermediate to match source
        utime($mtime, $mtime, $intermediate);
        ## Proceed to second-stage copy from there
        $destmap->{$intermediate} = $destmap->{$src};
        $src = $intermediate;
      }
    }
    foreach my $dest (@{$destmap->{$src}}) {
      unless ($opt{'n'}) {
        my $destdir = dirname($dest);
        if (! -w $todir) {
          ## 2nd-stage copy via sudo. No need for chmod here because the
          ## intermediate file has already got the right perms and cp -p 
          ## is used to preserve them.
          system("$SUDO -u $owner mkdir -p -m $dirmode_str $destdir") == 0 
	    and system("$SUDO -u $owner cp -p $src $dest") == 0 
	    or warn "2nd stage copy failed: $!" and $nerr++ and next;
        } else {
          ## Direct copy using File::Path and File::Copy
          eval {
            if (! -d $destdir) {
              mkpath($destdir, 0, $dirmode) or die "Failed to create destination directory.\n";
            }
            copy($src, $dest) or die "Failed to copy: $!\n";
            chmod($destmode, $dest) or die "Failed to chmod.\n";
          };
          if ($@) {
            warn "$dest: Direct Copy failed: $@\n";
            $nerr++;
            next;
          }
          ## Set mtime on dest to match source
          utime($mtime, $mtime, $dest);
        }
      }
      $ninst++;
    }
  }
  my $s = $ninst == 1 ? '' : 's';
  print " $ninst file$s ${not}installed.\n";
  print "*** $nerr ERRORS! ***\n" if ($nerr);
  return ($ninst, $nerr);
}

## Work out which of the given relative paths should be installed to $destdir
## according to whether they're new, updated, changed or unchanged.
## A hashref is returned: key = source path, value = arrayref of destination
## paths (may be more than one due to translation of ARCHIVEID).
sub calculate_install
{
  my ($destdir, $tmpdir, @candidate_files) = @_;
  my $filemap;
  foreach my $srcfile (@candidate_files) {
      my $destfile = "$destdir/$srcfile";
      if (&should_install($srcfile, $destfile)) {
        $filemap->{$srcfile} = [ $destfile ];
        system("diff -u $destfile $srcfile") if ($opt{'d'});
      }
  }
  return $filemap;
}

## Should $srcfile be installed to $destfile? (Full paths)
sub should_install
{
  my ($srcfile, $destfile) = @_;
  if (-e $destfile) {
    if (compare($srcfile, $destfile) == 0) {
      # print "  =  $srcfile\n";
      return 0;
    } 
    my $src_mtime = (stat($srcfile))[9];
    my $dest_mtime = (stat($destfile))[9];
    if ($src_mtime > $dest_mtime) {
      print "  +  $destfile\n";
      return 1;
    } elsif ($opt{'f'}) {
      print "  F  $destfile\n";
      return 1;
    } else {
      print "  -  $srcfile\n";
      return 0;
    }
  } else {
    print "  *  $destfile\n";
    return 1;
  }
  die "Logic error -- this should not be reached";
}
    

